home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / commandline.lisp < prev    next >
Encoding:
Text File  |  1992-05-30  |  6.8 KB  |  193 lines
  1. ;;; -*- Mode: Lisp; Package: Extensions; Log: code.log -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: commandline.lisp,v 1.2 91/02/08 13:31:31 ram Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; Stuff to eat the command line passed to us from the shell.
  15. ;;; Written by Bill Chiles.
  16. ;;;
  17.  
  18. (in-package "EXTENSIONS")
  19. (export '(*command-line-words* *command-line-switches*
  20.       *command-switch-demons* *command-line-utility-name*
  21.       *command-line-strings* cmd-switch-string command-line-switch-p
  22.       cmd-switch-name cmd-switch-value cmd-switch-words command-line-switch
  23.       defswitch cmd-switch-arg get-command-line-switch))
  24.  
  25. (defvar *command-line-switches* ()
  26.   "A list of cmd-switch's representing the arguments used to invoke
  27.   this process.")
  28.  
  29. (defvar *command-line-utility-name* ""
  30.   "The string name that was used to invoke this process.")
  31.  
  32. (defvar *command-line-words* ()
  33.   "A list of words between the utility name and the first switch.")
  34.  
  35. (defvar *command-line-strings* ()
  36.   "A list of strings obtained from the command line that invoked this process.")
  37.  
  38. (defvar *command-switch-demons* ()
  39.   "An Alist of (\"argument-name\" . demon-function)")
  40.  
  41.  
  42.  
  43. (defstruct (command-line-switch (:conc-name cmd-switch-)
  44.                 (:constructor make-cmd-switch
  45.                           (name value words))
  46.                 (:print-function print-command-line-switch))
  47.   name                 ;the name of the switch
  48.   value                 ;the value of that switch
  49.   words                 ;random words dangling between switches assigned to the
  50.                         ;preceeding switch
  51.   )
  52.  
  53. (defun print-command-line-switch (object stream n)
  54.   (declare (ignore n))
  55.   (write-string "#<Command Line Switch " stream)
  56.   (prin1 (cmd-switch-name object) stream)
  57.   (let ((value (cmd-switch-value object))
  58.     (words (cmd-switch-words object)))
  59.     (when (or value words) (write-string " -- " stream)
  60.       (when value (prin1 value stream))
  61.       (when words (prin1 words stream))))
  62.   (write-string ">" stream))
  63.  
  64.  
  65.  
  66. ;;;; Processing the command strings.
  67.  
  68. (defun process-command-strings ()
  69.   (setq *command-line-words* nil)
  70.   (setq *command-line-switches* nil)
  71.   (let ((cmd-strings lisp::lisp-command-line-list)
  72.     str)
  73.     (declare (special lisp::lisp-command-line-list))
  74.     ;; Set some initial variables.
  75.     ;; 
  76.     (setf *command-line-strings* (copy-list lisp::lisp-command-line-list))
  77.     (setf *command-line-utility-name* (pop cmd-strings))
  78.     (setq str (pop cmd-strings))
  79.     ;; Set initial command line words.
  80.     ;; 
  81.     (loop
  82.       (unless str (return nil))
  83.       (unless (zerop (length (the simple-string str)))
  84.     (when (char= (schar str 0) #\-) 
  85.       (setq *command-line-words* (reverse *command-line-words*))
  86.       (return nil))
  87.     (push str *command-line-words*))
  88.       (setq str (pop cmd-strings)))
  89.     ;; Set command line switches.
  90.     ;; 
  91.     (loop
  92.       (unless str
  93.     (return (setf *command-line-switches*
  94.               (nreverse *command-line-switches*))))
  95.       (let* ((position (position #\= (the simple-string str) :test #'char=))
  96.          (switch (subseq (the simple-string str) 1 position))
  97.          (value (if position
  98.             (subseq (the simple-string str) (1+ position)
  99.                 (length (the simple-string str))))))
  100.     (setq str (pop cmd-strings))
  101.     ;; Set this switches words until the next switch.
  102.     ;; 
  103.     (let (word-list)
  104.       (loop
  105.         (unless str
  106.           (push (make-cmd-switch switch value (nreverse word-list))
  107.             *command-line-switches*)
  108.           (return nil))
  109.         (unless (zerop (length (the simple-string str)))
  110.           (when (char= #\- (schar str 0))
  111.         (push (make-cmd-switch switch value (nreverse word-list))
  112.               *command-line-switches*)
  113.         (return nil))
  114.           (push str word-list))
  115.         (setq str (pop cmd-strings))))))))
  116.  
  117. (defun get-command-line-switch (sname)
  118.   "Accepts the name of a switch as a string and returns the value of the
  119.    switch.  If no value was specified, then any following words are returned.
  120.    If there are no following words, then t is returned.  If the switch was not
  121.    specified, then nil is returned."
  122.   (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname))
  123.      (switch (find name *command-line-switches*
  124.                :test #'string-equal
  125.                :key #'cmd-switch-name)))
  126.     (when switch
  127.       (or (cmd-switch-value switch)
  128.       (cmd-switch-words switch)
  129.       T))))
  130.  
  131.  
  132.  
  133. ;;;; Defining Switches and invoking demons.
  134.  
  135. (defvar *complain-about-illegal-switches* t
  136.   "When set, invoking switch demons complains about illegal switches that have
  137.    not been defined with DEFSWITCH.")
  138.  
  139. ;;; This is a list of legal switch names.  DEFSWITCH sets this, and
  140. ;;; INVOKE-SWITCH-DEMONS makes sure all the switches it sees are on this
  141. ;;; list.
  142. ;;;
  143. (defvar *legal-cmd-line-switches* nil)
  144.  
  145. ;;; INVOKE-SWITCH-DEMONS cdrs down the list of *command-line-switches*.  For
  146. ;;; each switch, it checks to see if there is a switch demon with the same
  147. ;;; name.  If there is, then that demon is called as a function on the switch.
  148. ;;;
  149. (defun invoke-switch-demons (&optional (switches *command-line-switches*)
  150.                      (demons *command-switch-demons*))
  151.   (dolist (switch switches t)
  152.     (let* ((name (cmd-switch-name switch))
  153.        (demon (cdr (assoc name demons :test #'string-equal))))
  154.       (cond (demon (funcall demon switch))
  155.         ((or (member name *legal-cmd-line-switches* :test #'string-equal)
  156.          (not *complain-about-illegal-switches*)))
  157.         (t (warn "~S is an illegal switch" switch))))))
  158.  
  159. (defmacro defswitch (name &optional function)
  160.   "Associates function with the switch name in *command-switch-demons*.  Name
  161.    is a simple-string that does not begin with a hyphen, unless the switch name
  162.    really does begin with one.  Function is optional, but defining the switch
  163.    is necessary to keep invoking switch demons from complaining about illegal
  164.    switches.  This can be inhibited with *complain-about-illegal-switches*."
  165.   (let ((gname (gensym))
  166.     (gfunction (gensym)))
  167.     `(let ((,gname ,name)
  168.        (,gfunction ,function))
  169.        (check-type ,gname simple-string)
  170.        (check-type ,gfunction (or symbol function) "a symbol or function")
  171.        (push ,gname *legal-cmd-line-switches*)
  172.        (when ,gfunction
  173.      (push (cons ,gname ,gfunction) *command-switch-demons*)))))
  174.  
  175.  
  176. (defun eval-switch-demon (switch)
  177.   (eval (read-from-string (cmd-switch-arg switch))))
  178. (defswitch "eval" #'eval-switch-demon)
  179.  
  180. (defun load-switch-demon (switch)
  181.   (load (cmd-switch-arg switch)))
  182. (defswitch "load" #'load-switch-demon)
  183.  
  184. (defun cmd-switch-arg (switch)
  185.   (or (cmd-switch-value switch)
  186.       (car (cmd-switch-words switch))
  187.       (car *command-line-words*)))
  188.  
  189. (defswitch "core")
  190. (defswitch "init")
  191. (defswitch "noinit")
  192. (defswitch "hinit")
  193.